home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / emacs-tools / haskell.el < prev    next >
Encoding:
Text File  |  1994-09-27  |  51.9 KB  |  1,427 lines  |  [TEXT/ttxt]
  1. ;;; ==================================================================
  2. ;;; File:         haskell.el                        ;;;
  3. ;;;                                                                ;;;
  4. ;;;            Author:     A. Satish Pai           ;;;
  5. ;;;                                     Maria M. Gutierrez         ;;;
  6. ;;;                                     Dan Rabin (Jul-1991)       ;;;
  7. ;;; ==================================================================
  8.  
  9. ;;; Description: Haskell mode for GNU Emacs.
  10.  
  11. ;;; Related files:  comint.el
  12.  
  13. ;;; Contents:
  14.  
  15. ;;;  Update Log
  16.  
  17. ;;;  Known bugs / problems
  18. ;;;  - the haskell editing mode (indentation, etc) is still missing.
  19. ;;;  - the handling for errors from haskell needs to be rethought.
  20. ;;;  - general cleanup of code.
  21.  
  22.  
  23. ;;;  Errors generated
  24.  
  25. ;;; ==================================================================
  26. ;;; Haskell mode for editing files, and an Inferior Haskell mode to
  27. ;;; run a Haskell process. This file contains stuff snarfed and 
  28. ;;; modified from tea.el, scheme.el, etc. This file may be freely
  29. ;;; modified; however, if you have any bug-corrections or useful
  30. ;;; improvements, I'd appreciate it if you sent me the mods so that
  31. ;;; I can merge them into the version I maintain.
  32. ;;;
  33. ;;; The inferior Haskell mode requires comint.el. 
  34. ;;; 
  35. ;;; You might want to add this to your .emacs to go automagically
  36. ;;; into Haskell mode while finding .hs files.
  37. ;;; 
  38. ;;;   (setq auto-mode-alist 
  39. ;;;         (cons '("\\.hs$" . haskell-mode)
  40. ;;;                auto-mode-alist)_)
  41. ;;;
  42. ;;; To use this file, set up your .emacs to autoload this file for 
  43. ;;; haskell-mode. For example:
  44. ;;; 
  45. ;;;    (autoload 'haskell-mode "$HASKELL/emacs-tools/haskell.elc" 
  46. ;;;       "Load Haskell mode" t)
  47. ;;;
  48. ;;;    (autoload 'run-mode "$HASKELL/emacs-tools/haskell.elc" 
  49. ;;;       "Load Haskell mode" t)
  50. ;;;
  51. ;;; [Note: The path name given above is Yale specific!! Modify as
  52. ;;; required.]
  53. ;;; ================================================================
  54.  
  55. ;;; Announce your existence to the world at large.
  56.  
  57. (provide 'haskell)
  58.  
  59.  
  60. ;;; Load these other files.
  61.  
  62. (require 'comint)        ; Olin Shivers' comint mode is the substratum
  63.  
  64.  
  65.  
  66.  
  67. ;;; ================================================================
  68. ;;; Declare a bunch of variables.
  69. ;;; ================================================================
  70.  
  71.  
  72. ;;; User settable (via M-x set-variable and M-x edit-options)
  73.  
  74. (defvar haskell-program-name (getenv "HASKELLPROG")
  75.   "*Program invoked by the haskell command.")
  76.  
  77. (defvar haskell-auto-create-process t
  78.   "*If not nil, create a Haskell process automatically when required to evaluate or compile Haskell code.")
  79.  
  80. (defvar haskell-auto-switch-input t
  81.   "*If not nil, jump to *haskell* buffer automatically on input request.")
  82.  
  83. (defvar haskell-ask-before-saving t
  84.   "*If not nil, ask before saving random haskell-mode buffers.")
  85.  
  86. (defvar haskell-initial-printers '("interactive")
  87.   "*Printers to set when starting a new Haskell process.")
  88.  
  89.  
  90. ;;; Pad/buffer Initialization variables
  91.  
  92. (defvar *haskell-buffer* "*haskell*"
  93.   "Name of the haskell process buffer")
  94.  
  95. (defvar haskell-main-pad "\*Main-pad\*"
  96.   "Scratch pad associated with module Main")
  97.  
  98. (defvar haskell-main-module "Main")
  99.  
  100.  
  101. (defvar *last-loaded* nil)
  102. (defvar *last-module* haskell-main-module)
  103. (defvar *last-pad* haskell-main-pad)
  104.  
  105.  
  106. ;;; These are used for haskell-tutorial mode.
  107.  
  108. (defvar *ht-source-file* "$HASKELL/progs/tutorial/tutorial.lhs")
  109. (defvar *ht-temp-buffer* nil)
  110. (defvar *ht-file-buffer* "Haskell-Tutorial-Master")
  111.  
  112.  
  113.  
  114. ;;; ================================================================
  115. ;;; Haskell editing mode stuff
  116. ;;; ================================================================
  117.  
  118. ;;; Leave this place alone...
  119. ;;; The definitions below have been pared down to the bare
  120. ;;; minimum; they will be restored later.
  121. ;;;
  122. ;;; -Satish 2/5.
  123.  
  124. ;;; Keymap for Haskell mode
  125. (defvar haskell-mode-map (make-sparse-keymap)
  126.   "Keymap used for haskell-mode")
  127.  
  128. (defun haskell-establish-key-bindings (keymap)
  129.   (define-key keymap "\C-ce"    'haskell-eval)
  130.   (define-key keymap "\C-cr"    'haskell-run)
  131.   (define-key keymap "\C-ct"    'haskell-report-type)
  132.   (define-key keymap "\C-cm"    'haskell-run-main)
  133.   (define-key keymap "\C-c\C-r" 'haskell-run-file)
  134.   (define-key keymap "\C-cp"    'haskell-get-pad)
  135.   (define-key keymap "\C-c\C-o" 'haskell-optimizers)
  136.   (define-key keymap "\C-c\C-p" 'haskell-printers)
  137.   (define-key keymap "\C-cc"    'haskell-compile)
  138.   (define-key keymap "\C-cl"    'haskell-load)
  139.   (define-key keymap "\C-ch"    'haskell-switch)
  140.   (define-key keymap "\C-c\C-k" 'haskell-kill)
  141.   (define-key keymap "\C-c:"    'haskell-command)
  142.   (define-key keymap "\C-cq"    'haskell-exit)
  143.   (define-key keymap "\C-ci"    'haskell-interrupt)
  144.   (define-key keymap "\C-cu"    'haskell-edit-unit))
  145.  
  146.  
  147. (haskell-establish-key-bindings haskell-mode-map)
  148.  
  149.  
  150. (defvar haskell-mode-syntax-table nil
  151.   "Syntax table used for haskell-mode")
  152.  
  153. (if haskell-mode-syntax-table
  154.     nil
  155.     (setq haskell-mode-syntax-table (standard-syntax-table)))
  156.  
  157. ;;; Command for invoking the Haskell mode
  158. (defun haskell-mode nil
  159.   "Major mode for editing Haskell code to run in Emacs
  160. The following commands are available:
  161. \\{haskell-mode-map}
  162.  
  163. A Haskell process can be fired up with \"M-x haskell\". 
  164.  
  165. Customization: Entry to this mode runs the hooks that are the value of variable 
  166. haskell-mode-hook.
  167.  
  168. Windows:
  169.  
  170. There are 3 types of windows associated with Haskell mode.  They are:
  171.    *haskell*:  which is the process window.
  172.    Pad:        which are buffers available for each module.  It is here
  173.                where you want to test things before preserving them in a
  174.                file.  Pads are always associated with a module.
  175.                When issuing a command:
  176.                  The pad and its associated module are sent to the Haskell
  177.                  process prior to the execution of the command.
  178.    .hs:        These are the files where Haskell programs live.  They
  179.                have .hs as extension.
  180.                When issuing a command:
  181.                  The file is sent to the Haskell process prior to the
  182.                  execution of the command.
  183.  
  184. Commands:
  185.  
  186. Each command behaves differently according to the type of the window in which 
  187. the cursor is positioned when the command is issued .
  188.  
  189. haskell-eval:   \\[haskell-eval]
  190.   Always promts user for a Haskell expression to be evaluated.  If in a
  191.   .hs file buffer, then the cursor tells which module is the current 
  192.   module and the pad for that module (if any) gets loaded as well.
  193.  
  194. haskell-run:    \\[haskell-run]
  195.   Always queries for a variable of type Dialogue to be evaluated.
  196.  
  197. haskell-run-main:    \\[haskell-run-main]
  198.   Run Dialogue named main in the current module.
  199.  
  200. haskell-report-type:   \\[haskell-report-type]
  201.   Like haskell-eval, but prints the type of the expression without
  202.   evaluating it.
  203.  
  204. haskell-mode:   \\[haskell-mode]
  205.   Puts the current buffer in haskell mode.
  206.  
  207. haskell-compile:   \\[haskell-compile]
  208.   Compiles file in current buffer.
  209.  
  210. haskell-load:   \\[haskell-load]
  211.   Loads file in current buffer.
  212.  
  213. haskell-run-file:   \\[haskell-run-file]
  214.   Runs file in the current buffer.
  215.  
  216. haskell-pad:   \\[haskell-pad]
  217.   Creates a scratch pad for the current module.
  218.  
  219. haskell-optimizers:  \\[haskell-optimizers]
  220.   Shows the list of available optimizers.  Commands for turning them on/off.
  221.  
  222. haskell-printers:  \\[haskell-printers]
  223.   Shows the list of available printers.  Commands for turning them on/off.
  224.  
  225. haskell-command:   \\[haskell-command]
  226.   Prompts for a command to be sent to the command interface.  You don't
  227.   need to put the : before the command.
  228.  
  229. haskell-quit:   \\[haskell-quit]
  230.   Terminates the haskell process.
  231.  
  232. haskell-switch:   \\[haskell-switch]
  233.   Switches to the inferior Haskell buffer (*haskell*) and positions the
  234.   cursor at the end of the buffer.
  235.  
  236. haskell-kill:  \\[haskell-kill]
  237.   Kill the current contents of the *haskell* buffer.
  238.   
  239. haskell-interrupt:   \\[haskell-interrupt]
  240.   Interrupts haskell process and resets it.
  241.  
  242. haskell-edit-unit:   \\[haskell-edit-unit]
  243.   Edit the .hu file for the unit containing this file.
  244. "
  245.   (interactive)
  246.   (kill-all-local-variables)
  247.   (use-local-map haskell-mode-map)
  248.   (setq major-mode 'haskell-mode)
  249.   (setq mode-name "Haskell")
  250.   (make-local-variable 'indent-line-function)
  251.   (setq indent-line-function 'indent-relative-maybe)
  252.   ;(setq local-abbrev-table haskell-mode-abbrev-table)
  253.   (set-syntax-table haskell-mode-syntax-table)
  254.   ;(setq tab-stop-list haskell-tab-stop-list) ;; save old list??
  255.   (run-hooks 'haskell-mode-hook))
  256.  
  257.  
  258.  
  259. ;;;================================================================
  260. ;;; Inferior Haskell stuff
  261. ;;;================================================================
  262.  
  263.  
  264. (defvar inferior-haskell-mode-map (full-copy-sparse-keymap comint-mode-map))
  265.  
  266. (haskell-establish-key-bindings inferior-haskell-mode-map)
  267. (define-key inferior-haskell-mode-map "\C-m"     'haskell-send-input)
  268.  
  269. (defvar haskell-source-modes '(haskell-mode)
  270.   "*Used to determine if a buffer contains Haskell source code.
  271. If it's loaded into a buffer that is in one of these major modes, 
  272. it's considered a Haskell source file.")
  273.  
  274. (defvar haskell-prompt-pattern "^[A-Z]\\([A-Z]\\|[a-z]\\|[0-9]\\)*>\\s-*"
  275.   "Regular expression capturing the Haskell system prompt.")
  276.  
  277. (defvar haskell-prompt-ring ()
  278.   "Keeps track of input to haskell process from the minibuffer")
  279.  
  280. (defun inferior-haskell-mode-variables ()
  281.   nil)  
  282.  
  283.  
  284. ;;; INFERIOR-HASKELL-MODE (adapted from comint.el)
  285.  
  286. (defun inferior-haskell-mode ()
  287.   "Major mode for interacting with an inferior Haskell process.
  288.  
  289. The following commands are available:
  290. \\{inferior-haskell-mode-map}
  291.  
  292. A Haskell process can be fired up with \"M-x haskell\". 
  293.  
  294. Customization: Entry to this mode runs the hooks on comint-mode-hook and
  295. inferior-haskell-mode-hook (in that order).
  296.  
  297. You can send text to the inferior Haskell process from other buffers containing
  298. Haskell source.  
  299.  
  300.  
  301. Windows:
  302.  
  303. There are 3 types of windows in the inferior-haskell-mode.  They are:
  304.    *haskell*:  which is the process window.
  305.    Pad:        which are buffers available for each module.  It is here
  306.                where you want to test things before preserving them in a
  307.                file.  Pads are always associated with a module.
  308.                When issuing a command:
  309.                  The pad and its associated module are sent to the Haskell
  310.                  process prior to the execution of the command.
  311.    .hs:        These are the files where Haskell programs live.  They
  312.                have .hs as extension.
  313.                When issuing a command:
  314.                  The file is sent to the Haskell process prior to the
  315.                  execution of the command.
  316.  
  317. Commands:
  318.  
  319. Each command behaves differently according to the type of the window in which 
  320. the cursor is positioned when the command is issued.
  321.  
  322. haskell-eval:   \\[haskell-eval]
  323.   Always promts user for a Haskell expression to be evaluated.  If in a
  324.   .hs file, then the cursor tells which module is the current module and
  325.   the pad for that module (if any) gets loaded as well.
  326.  
  327. haskell-run:    \\[haskell-run]
  328.   Always queries for a variable of type Dialogue to be evaluated.
  329.  
  330. haskell-run-main:    \\[haskell-run-main]
  331.   Run Dialogue named main.
  332.  
  333. haskell-report-type:   \\[haskell-report-type]
  334.   Like haskell-eval, but prints the type of the expression without
  335.   evaluating it.
  336.  
  337. haskell-mode:   \\[haskell-mode]
  338.   Puts the current buffer in haskell mode.
  339.  
  340. haskell-compile:   \\[haskell-compile]
  341.   Compiles file in current buffer.
  342.  
  343. haskell-load:   \\[haskell-load]
  344.   Loads file in current buffer.
  345.  
  346. haskell-run-file:   \\[haskell-run-file]
  347.   Runs file in the current buffer.
  348.  
  349. haskell-pad:   \\[haskell-pad]
  350.   Creates a scratch pad for the current module.
  351.  
  352. haskell-optimizers:  \\[haskell-optimizers]
  353.   Shows the list of available optimizers.  Commands for turning them on/off.
  354.  
  355. haskell-printers:  \\[haskell-printers]
  356.   Shows the list of available printers.  Commands for turning them on/off.
  357.  
  358. haskell-command:   \\[haskell-command]
  359.   Prompts for a command to be sent to the command interface.  You don't
  360.   need to put the : before the command.
  361.  
  362. haskell-quit:   \\[haskell-quit]
  363.   Terminates the haskell process.
  364.  
  365. haskell-switch:   \\[haskell-switch]
  366.   Switches to the inferior Haskell buffer (*haskell*) and positions the
  367.   cursor at the end of the buffer.
  368.  
  369. haskell-kill:  \\[haskell-kill]
  370.   Kill the current contents of the *haskell* buffer.
  371.   
  372. haskell-interrupt:   \\[haskell-interrupt]
  373.   Interrupts haskell process and resets it.
  374.  
  375. haskell-edit-unit:   \\[haskell-edit-unit]
  376.   Edit the .hu file for the unit containing this file.
  377.  
  378. The usual comint functions are also available. In particular, the 
  379. following are all available:
  380.  
  381. comint-bol: Beginning of line, but skip prompt. Bound to C-a by default.
  382. comint-delchar-or-maybe-eof: Delete char, unless at end of buffer, in 
  383.             which case send EOF to process. Bound to C-d by default.
  384.  
  385. Note however, that the default keymap bindings provided shadow some of
  386. the default comint mode bindings, so that you may want to bind them 
  387. to your choice of keys. 
  388.  
  389. Comint mode's dynamic completion of filenames in the buffer is available.
  390. (Q.v. comint-dynamic-complete, comint-dynamic-list-completions.)
  391.  
  392. If you accidentally suspend your process, use \\[comint-continue-subjob]
  393. to continue it."
  394.  
  395.   (interactive)
  396.   (comint-mode)
  397.   (setq comint-prompt-regexp haskell-prompt-pattern)
  398.   ;; Customise in inferior-haskell-mode-hook
  399.   (inferior-haskell-mode-variables) 
  400.   (setq major-mode 'inferior-haskell-mode)
  401.   (setq mode-name "Inferior Haskell")
  402.   (setq mode-line-process '(": %s : busy"))
  403.   (use-local-map inferior-haskell-mode-map)
  404.   (setq comint-input-filter 'haskell-input-filter)
  405.   (setq comint-input-sentinel 'ignore)
  406.   (setq comint-get-old-input 'haskell-get-old-input)
  407.   (run-hooks 'inferior-haskell-mode-hook)
  408.     ;Do this after the hook so the user can mung INPUT-RING-SIZE w/his hook.
  409.     ;The test is so we don't lose history if we run comint-mode twice in
  410.     ;a buffer.
  411.   (setq haskell-prompt-ring (make-ring input-ring-size)))
  412.  
  413.  
  414. (defun haskell-input-filter (str)
  415.   "Don't save whitespace."
  416.   (not (string-match "\\s *" str)))
  417.  
  418.  
  419.  
  420. ;;; ==================================================================
  421. ;;; Random utilities
  422. ;;; ==================================================================
  423.  
  424.  
  425. ;;; This keeps track of the status of the haskell process.
  426. ;;; Values are:
  427. ;;; busy -- The process is busy.
  428. ;;; ready -- The process is ready for a command.
  429. ;;; input -- The process is waiting for input.
  430. ;;; debug -- The process is in the debugger.
  431.  
  432. (defvar *haskell-status* 'busy
  433.   "Status of the haskell process")
  434.  
  435. (defun set-haskell-status (value)
  436.   (setq *haskell-status* value)
  437.   (haskell-update-mode-line))
  438.  
  439. (defun get-haskell-status ()
  440.   *haskell-status*)
  441.  
  442. (defun haskell-update-mode-line ()
  443.   (save-excursion
  444.     (set-buffer *haskell-buffer*)
  445.     (cond ((eq *haskell-status* 'ready)
  446.        (setq mode-line-process '(": %s: ready")))
  447.       ((eq *haskell-status* 'input)
  448.        (setq mode-line-process '(": %s: input")))
  449.       ((eq *haskell-status* 'busy)
  450.        (setq mode-line-process '(": %s: busy")))
  451.       ((eq *haskell-status* 'debug)
  452.        (setq mode-line-process '(": %s: debug")))
  453.       (t
  454.        (haskell-mode-error "Confused about status of haskell process!")))
  455.     ;; Yes, this is the officially sanctioned technique for forcing
  456.     ;; a redisplay of the mode line.
  457.     (set-buffer-modified-p (buffer-modified-p))))
  458.  
  459.  
  460. (defun haskell-send-to-process (string)
  461.   (process-send-string "haskell" string)
  462.   (process-send-string "haskell" "\n"))
  463.  
  464.  
  465.  
  466. ;;; ==================================================================
  467. ;;; Handle input in haskell process buffer; history commands.
  468. ;;; ==================================================================
  469.  
  470. (defun haskell-get-old-input ()
  471.   "Get old input text from Haskell process buffer."
  472.   (save-excursion
  473.     (if (re-search-forward haskell-prompt-pattern (point-max) 'move)
  474.     (goto-char (match-beginning 0)))
  475.     (cond ((re-search-backward haskell-prompt-pattern (point-min) t)
  476.        (comint-skip-prompt)
  477.        (let ((temp  (point)))
  478.          (end-of-line)
  479.          (buffer-substring temp (point)))))))
  480.  
  481.  
  482. (defun haskell-send-input ()
  483.   "Send input to Haskell while in the process buffer"
  484.   (interactive)
  485.   (if (eq (get-haskell-status) 'debug)
  486.       (comint-send-input)
  487.       (haskell-send-input-aux)))
  488.  
  489. (defun haskell-send-input-aux ()
  490.   ;; Note that the input string does not include its terminal newline.
  491.   (let ((proc (get-buffer-process (current-buffer))))
  492.     (if (not proc)
  493.     (haskell-mode-error "Current buffer has no process!")
  494.     (let* ((pmark (process-mark proc))
  495.            (pmark-val (marker-position pmark))
  496.            (input (if (>= (point) pmark-val)
  497.               (buffer-substring pmark (point))
  498.               (let ((copy (funcall comint-get-old-input)))
  499.                 (goto-char pmark)
  500.                 (insert copy)
  501.                 copy))))
  502.       (insert ?\n)
  503.       (if (funcall comint-input-filter input)
  504.           (ring-insert input-ring input))
  505.       (funcall comint-input-sentinel input)
  506.       (set-marker (process-mark proc) (point))
  507.       (set-marker comint-last-input-end (point))
  508.       (haskell-send-to-process input)))))
  509.  
  510.  
  511.  
  512. ;;; ==================================================================
  513. ;;; Minibuffer input stuff
  514. ;;; ==================================================================
  515.  
  516. ;;; Haskell input history retrieval commands   (taken from comint.el)
  517. ;;; M-p -- previous input    M-n -- next input
  518.  
  519. (defvar haskell-minibuffer-local-map nil
  520.   "Local map for minibuffer when in Haskell")
  521.  
  522. (if haskell-minibuffer-local-map
  523.     nil
  524.     (progn
  525.       (setq haskell-minibuffer-local-map
  526.         (full-copy-sparse-keymap minibuffer-local-map))
  527.       ;; Haskell commands
  528.       (define-key haskell-minibuffer-local-map "\ep"   'haskell-previous-input)
  529.       (define-key haskell-minibuffer-local-map "\en"   'haskell-next-input)
  530.       ))
  531.  
  532. (defun haskell-previous-input (arg)
  533.   "Cycle backwards through input history."
  534.   (interactive "*p")
  535.   (let ((len (ring-length haskell-prompt-ring)))
  536.     (cond ((<= len 0)
  537.        (message "Empty input ring.")
  538.        (ding))
  539.       (t
  540.        (cond ((eq last-command 'haskell-previous-input)
  541.           (delete-region (mark) (point))
  542.           (set-mark (point)))
  543.          (t                          
  544.           (setq input-ring-index
  545.             (if (> arg 0) -1
  546.                 (if (< arg 0) 1 0)))
  547.           (push-mark (point))))
  548.        (setq input-ring-index (comint-mod (+ input-ring-index arg) len))
  549.        (insert (ring-ref haskell-prompt-ring input-ring-index))
  550.        (setq this-command 'haskell-previous-input))
  551.       )))
  552.      
  553. (defun haskell-next-input (arg)
  554.   "Cycle forwards through input history."
  555.   (interactive "*p")
  556.   (haskell-previous-input (- arg)))
  557.  
  558. (defvar haskell-last-input-match ""
  559.   "Last string searched for by Haskell input history search, for defaulting.
  560. Buffer local variable.") 
  561.  
  562. (defun haskell-previous-input-matching (str)
  563.   "Searches backwards through input history for substring match"
  564.   (interactive (let ((s (read-from-minibuffer 
  565.              (format "Command substring (default %s): "
  566.                  haskell-last-input-match))))
  567.          (list (if (string= s "") haskell-last-input-match s))))
  568.   (setq haskell-last-input-match str) ; update default
  569.   (let ((str (regexp-quote str))
  570.         (len (ring-length haskell-prompt-ring))
  571.     (n 0))
  572.     (while (and (<= n len)
  573.         (not (string-match str (ring-ref haskell-prompt-ring n))))
  574.       (setq n (+ n 1)))
  575.     (cond ((<= n len) (haskell-previous-input (+ n 1)))
  576.       (t (haskell-mode-error "Not found.")))))
  577.  
  578.  
  579. ;;; Actually read an expression from the minibuffer using the new keymap.
  580.  
  581. (defun haskell-get-expression (prompt)
  582.   (let ((exp  (read-from-minibuffer prompt nil haskell-minibuffer-local-map)))
  583.     (ring-insert haskell-prompt-ring exp)
  584.     exp))
  585.  
  586.  
  587.  
  588. ;;; ==================================================================
  589. ;;; Handle output from Haskell process
  590. ;;; ==================================================================
  591.  
  592. ;;; The haskell process produces output with embedded control codes.
  593. ;;; These control codes are used to keep track of what kind of input
  594. ;;; the haskell process is expecting.  Ordinary output is just displayed.
  595. ;;;
  596. ;;; This is kind of complicated because control sequences can be broken
  597. ;;; across multiple batches of text received from the haskell process.
  598. ;;; If the string ends in the middle of a control sequence, save it up
  599. ;;; for the next call.
  600.  
  601. (defvar *haskell-saved-output* nil)
  602.  
  603. ;;; On the Next, there is some kind of race condition that causes stuff
  604. ;;; sent to the Haskell subprocess before it has really started to be lost.
  605. ;;; The point of this variable is to force the Emacs side to wait until
  606. ;;; Haskell has started and printed out its banner before sending it
  607. ;;; anything.  See start-haskell below.
  608.  
  609. (defvar *haskell-process-alive* nil)
  610.  
  611. (defun haskell-output-filter (process str)
  612.   "Filter for output from Yale Haskell command interface"
  613.   ;; *** debug
  614.   ;;(let ((buffer  (get-buffer-create "haskell-output")))
  615.   ;;  (save-excursion
  616.   ;;    (set-buffer buffer)
  617.   ;;    (insert str)))
  618.   (setq *haskell-process-alive* t)
  619.   (let ((next    0)
  620.     (start   0)
  621.     (data    (match-data)))
  622.     (unwind-protect
  623.     (progn
  624.       ;; If there was saved output from last time, glue it in front of the
  625.       ;; newly received input.
  626.       (if *haskell-saved-output*
  627.           (progn
  628.         (setq str (concat *haskell-saved-output* str))
  629.         (setq *haskell-saved-output* nil)))
  630.       ;; Loop, looking for complete command sequences.
  631.       ;; Set next to point to the first one.
  632.       ;; start points to first character to be processed.
  633.       (while (setq next
  634.                (string-match *haskell-message-match-regexp*
  635.                      str start))
  636.         ;; Display any intervening ordinary text.
  637.         (if (not (eq next start))
  638.         (haskell-display-output (substring str start next)))
  639.         ;; Now dispatch on the particular command sequence found.
  640.         ;; Handler functions are called with the string and start index
  641.         ;; as arguments, and should return the index of the "next"
  642.         ;; character.
  643.         (let ((end  (match-end 0)))
  644.           (haskell-handle-message str next)
  645.           (setq start end)))
  646.       ;; Look to see whether the string ends with an incomplete 
  647.       ;; command sequence.
  648.       ;; If so, save the tail of the string for next time.
  649.       (if (and (setq next
  650.              (string-match *haskell-message-prefix-regexp* str start))
  651.            (eq (match-end 0) (length str)))
  652.               (setq *haskell-saved-output* (substring str next))
  653.           (setq next (length str)))
  654.       ;; Display any leftover ordinary text.
  655.       (if (not (eq next start))
  656.           (haskell-display-output (substring str start next))))
  657.       (store-match-data data))))
  658.  
  659. (defvar *haskell-message-match-regexp*
  660.   "EMACS:.*\n")
  661.  
  662. (defvar *haskell-message-prefix-regexp*
  663.   "E\\(M\\(A\\(C\\(S\\(:.*\\)?\\)?\\)?\\)?\\)?")
  664.  
  665. (defvar *haskell-message-dispatch*
  666.   '(("EMACS:debug\n"         . haskell-got-debug)
  667.     ("EMACS:busy\n"          . haskell-got-busy)
  668.     ("EMACS:input\n"         . haskell-got-input)
  669.     ("EMACS:ready\n"         . haskell-got-ready)
  670.     ("EMACS:printers .*\n"   . haskell-got-printers)
  671.     ("EMACS:optimizers .*\n" . haskell-got-optimizers)
  672.     ("EMACS:message .*\n"    . haskell-got-message)
  673.     ("EMACS:error\n"         . haskell-got-error)
  674.     ))
  675.  
  676. (defun haskell-handle-message (str idx)
  677.   (let ((list  *haskell-message-dispatch*)
  678.     (fn    nil))
  679.     (while (and list (null fn))
  680.       (if (eq (string-match (car (car list)) str idx) idx)
  681.       (setq fn (cdr (car list)))
  682.       (setq list (cdr list))))
  683.     (if (null fn)
  684.     (haskell-mode-error "Garbled message from Haskell!")
  685.     (let ((end  (match-end 0)))
  686.       (funcall fn str idx end)
  687.       end))))
  688.  
  689.  
  690. (defun haskell-message-data (string start end)
  691.   (let ((real-start  (+ (string-match " " string start) 1))
  692.     (real-end    (- end 1)))
  693.     (substring string real-start real-end)))
  694.  
  695. (defun haskell-got-debug (string start end)
  696.   (beep)
  697.   (message "In the debugger!")
  698.   (set-haskell-status 'debug))
  699.  
  700. (defun haskell-got-busy (string start end)
  701.   (set-haskell-status 'busy))
  702.  
  703. (defun haskell-got-input (string start end)
  704.   (if haskell-auto-switch-input
  705.       (progn
  706.     (haskell-switch)
  707.     (beep)))
  708.   (set-haskell-status 'input)
  709.   (message "Waiting for input..."))
  710.  
  711. (defun haskell-got-ready (string start end)
  712.   (set-haskell-status 'ready))
  713.  
  714. (defun haskell-got-printers (string start end)
  715.   (haskell-printers-update (haskell-message-data string start end)))
  716.  
  717. (defun haskell-got-optimizers (string start end)
  718.   (haskell-optimizers-update (haskell-message-data string start end)))
  719.  
  720. (defun haskell-got-message (string start end)
  721.   (message "%s" (haskell-message-data string start end)))
  722.  
  723. (defun haskell-got-error (string start end)
  724.   (beep)
  725.   (message "Haskell error."))
  726.  
  727.  
  728. ;;; Displays output at end of given buffer.
  729. ;;; This function only ensures that the output is visible, without 
  730. ;;; selecting the buffer in which it is displayed.
  731. ;;; Note that just using display-buffer instead of all this rigamarole
  732. ;;; won't work; you need to temporarily select the window containing
  733. ;;; the *haskell-buffer*, or else the display won't be scrolled to show
  734. ;;; the new output.
  735. ;;; *** This should really position the window in the buffer so that 
  736. ;;; *** the point is on the last line of the window.
  737.  
  738. (defun haskell-display-output (str)
  739.   (let ((window  (selected-window)))
  740.     (unwind-protect
  741.     (progn
  742.       (pop-to-buffer *haskell-buffer*)
  743.       (haskell-display-output-aux str))
  744.       (select-window window))))
  745.  
  746. (defun haskell-display-output-aux (str)
  747.   (haskell-move-marker)
  748.   (insert str)
  749.   (haskell-move-marker))
  750.  
  751.  
  752.  
  753. ;;; ==================================================================
  754. ;;; Interactive commands
  755. ;;; ==================================================================
  756.  
  757.  
  758. ;;; HASKELL
  759. ;;; -------
  760. ;;;
  761. ;;; This is the function that fires up the inferior haskell process.
  762.  
  763. (defun haskell ()
  764.   "Run an inferior Haskell process with input and output via buffer *haskell*.
  765. Takes the program name from the variable haskell-program-name.  
  766. Runs the hooks from inferior-haskell-mode-hook 
  767. (after the comint-mode-hook is run).
  768. \(Type \\[describe-mode] in the process buffer for a list of commands.)"
  769.   (interactive)
  770.   (if (not (haskell-process-exists-p))
  771.     (start-haskell)))
  772.  
  773. (defun start-haskell ()
  774.   (message "Starting haskell subprocess...")
  775.   ;; Kill old haskell process.  Normally this routine is only called
  776.   ;; after checking haskell-process-exists-p, but things can get
  777.   ;; screwed up if you rename the *haskell* buffer while leaving the
  778.   ;; old process running.  This forces it to get rid of the old process
  779.   ;; and start a new one.
  780.   (if (get-process "haskell")
  781.       (delete-process "haskell"))
  782.   (let ((haskell-buffer
  783.      (apply 'make-comint
  784.         "haskell"
  785.         (or haskell-program-name
  786.             (haskell-mode-error "Haskell-program-name undefined!"))
  787.         nil
  788.         nil)))
  789.     (save-excursion
  790.       (set-buffer haskell-buffer)
  791.       (inferior-haskell-mode))
  792.     (haskell-session-init)
  793.     ;; Wait for process to get started before sending it anything
  794.     ;; to avoid race condition on NeXT.
  795.     (setq *haskell-process-alive* nil)
  796.     (while (not *haskell-process-alive*)
  797.       (sleep-for 1))
  798.     (haskell-send-to-process ":(use-emacs-interface)")
  799.     (haskell-printers-set haskell-initial-printers nil)
  800.     (display-buffer haskell-buffer))
  801.   (message "Starting haskell subprocess...  Done."))
  802.  
  803.  
  804. (defun haskell-process-exists-p ()
  805.   (let ((haskell-buffer  (get-buffer *haskell-buffer*)))
  806.     (and haskell-buffer (comint-check-proc haskell-buffer))))
  807.  
  808.  
  809.  
  810. ;;; Initialize things on the emacs side, and tell haskell that it's
  811. ;;; talking to emacs.
  812.  
  813. (defun haskell-session-init ()
  814.   (set-haskell-status 'busy)
  815.   (setq *last-loaded* nil)
  816.   (setq *last-module* haskell-main-module)
  817.   (setq *last-pad* haskell-main-pad)
  818.   (setq *haskell-saved-output* nil)
  819.   (haskell-create-main-pad)
  820.   (set-process-filter (get-process "haskell") 'haskell-output-filter)
  821.   )
  822.  
  823.  
  824. (defun haskell-create-main-pad ()
  825.   (let ((buffer (get-buffer-create haskell-main-pad)))
  826.     (save-excursion
  827.       (set-buffer buffer)
  828.       (haskell-mode))
  829.     (haskell-record-pad-mapping
  830.       haskell-main-pad haskell-main-module nil)
  831.     buffer))
  832.  
  833.  
  834. ;;; Called from evaluation and compilation commands to start up a Haskell
  835. ;;; process if none is already in progress.
  836.  
  837. (defun haskell-maybe-create-process ()
  838.   (cond ((haskell-process-exists-p)
  839.      t)
  840.     (haskell-auto-create-process
  841.      (start-haskell))
  842.     (t
  843.      (haskell-mode-error "No Haskell process!"))))
  844.  
  845.  
  846.  
  847. ;;; HASKELL-GET-PAD
  848. ;;; ------------------------------------------------------------------
  849.  
  850. ;;; This always puts the pad buffer in the "other" window.
  851. ;;; Having it wipe out the .hs file window is clearly the wrong
  852. ;;; behavior.
  853.  
  854. (defun haskell-get-pad ()
  855.   "Creates a new scratch pad for the current module.
  856. Signals an error if the current buffer is not a .hs file."
  857.   (interactive)
  858.   (let ((fname (buffer-file-name)))
  859.     (if fname
  860.     (do-get-pad fname (current-buffer))
  861.         (haskell-mode-error "Not in a .hs buffer!"))))
  862.  
  863.  
  864. (defun do-get-pad (fname buff)
  865.   (let* ((mname (or (haskell-get-modname buff)
  866.             (read-no-blanks-input "Scratch pad for module? " nil)))
  867.      (pname (haskell-lookup-pad mname fname))
  868.      (pbuff nil))
  869.     ;; Generate the base name of the pad buffer, then create the
  870.     ;; buffer.  The actual name of the pad buffer may be something
  871.     ;; else because of name collisions.
  872.     (if (not pname)
  873.     (progn
  874.       (setq pname (format "*%s-pad*" mname))
  875.       (setq pbuff (generate-new-buffer pname))
  876.       (setq pname (buffer-name pbuff))
  877.       (haskell-record-pad-mapping pname mname fname)
  878.       )
  879.     (setq pbuff (get-buffer pname)))
  880.     ;; Make sure the pad buffer is in haskell mode.
  881.     (pop-to-buffer pbuff)
  882.     (haskell-mode)))
  883.  
  884.  
  885.  
  886. ;;; HASKELL-SWITCH
  887. ;;; ------------------------------------------------------------------
  888.  
  889. (defun haskell-switch ()
  890.   "Switches to \*haskell\* buffer."
  891.   (interactive)
  892.   (haskell-maybe-create-process)
  893.   (pop-to-buffer *haskell-buffer*)
  894.   (push-mark)
  895.   (goto-char (point-max)))
  896.  
  897.  
  898.  
  899. ;;; HASKELL-KILL
  900. ;;; ------------------------------------------------------------------
  901.  
  902. (defun haskell-kill ()
  903.   "Kill contents of *haskell* buffer.  \\[haskell-kill]"
  904.   (interactive)
  905.   (save-excursion
  906.     (set-buffer *haskell-buffer*)
  907.     (beginning-of-buffer)
  908.     (let ((mark  (point)))
  909.       (end-of-buffer)
  910.       (kill-region mark (point)))))
  911.  
  912.  
  913.  
  914. ;;; HASKELL-COMMAND
  915. ;;; ------------------------------------------------------------------
  916.  
  917. (defun haskell-command (str)
  918.   "Format STRING as a haskell command and send it to haskell process.  \\[haskell-command]"
  919.   (interactive "sHaskell command: ")
  920.   (haskell-send-to-process (format ":%s" str)))
  921.  
  922.  
  923. ;;; HASKELL-EVAL and HASKELL-RUN
  924. ;;; ------------------------------------------------------------------
  925.  
  926. (defun haskell-eval ()
  927.   "Evaluate expression in current module. \\[haskell-eval]"
  928.   (interactive)
  929.   (haskell-maybe-create-process)
  930.   (haskell-eval-aux (haskell-get-expression "Haskell expression: ")
  931.             "emacs-eval"))
  932.  
  933. (defun haskell-run ()
  934.   "Run Haskell Dialogue in current module"
  935.   (interactive)
  936.   (haskell-maybe-create-process)
  937.   (haskell-eval-aux (haskell-get-expression "Haskell dialogue: ")
  938.             "emacs-run"))
  939.  
  940. (defun haskell-run-main ()
  941.   "Run Dialogue named main in current module"
  942.   (interactive)
  943.   (haskell-maybe-create-process)
  944.   (haskell-eval-aux "main" "emacs-run"))
  945.  
  946. (defun haskell-report-type ()
  947.   "Print the type of the expression."
  948.   (interactive)
  949.   (haskell-maybe-create-process)
  950.   (haskell-eval-aux (haskell-get-expression "Haskell expression: ")
  951.             "emacs-report-type"))
  952.  
  953. (defun haskell-eval-aux (exp fn)
  954.   (cond ((equal *haskell-buffer* (buffer-name))
  955.      ;; In the *haskell* buffer.
  956.      (let* ((pname  *last-pad*)
  957.         (mname  *last-module*)
  958.         (fname  *last-loaded*))
  959.        (haskell-eval-aux-aux exp pname mname fname fn)))
  960.     ((buffer-file-name)
  961.      ;; In a .hs file.
  962.      (let* ((fname  (buffer-file-name))
  963.         (mname  (haskell-get-modname (current-buffer)))
  964.         (pname  (haskell-lookup-pad mname fname)))
  965.        (haskell-eval-aux-aux exp pname mname fname fn)))
  966.     (t
  967.      ;; In a pad.
  968.      (let* ((pname  (buffer-name (current-buffer)))
  969.         (mname  (haskell-get-module-from-pad pname))
  970.         (fname  (haskell-get-file-from-pad pname)))
  971.        (haskell-eval-aux-aux exp pname mname fname fn)))
  972.     ))
  973.  
  974. (defun haskell-eval-aux-aux (exp pname mname fname fn)
  975.   (haskell-save-modified-source-files fname)
  976.   (haskell-send-to-process (format ":(%s" fn))
  977.   (haskell-send-to-process
  978.     (prin1-to-string exp))
  979.   (haskell-send-to-process
  980.     (prin1-to-string (or pname fname "interactive")))
  981.   (haskell-send-to-process
  982.     (prin1-to-string
  983.       (if (and pname (get-buffer pname))
  984.       (save-excursion
  985.         (set-buffer pname)
  986.         (buffer-string))
  987.       "")))
  988.   (haskell-send-to-process
  989.     (format "'|%s|" mname))
  990.   (haskell-send-to-process
  991.     (if fname
  992.     (prin1-to-string (haskell-maybe-get-unit-file-name fname))
  993.     "'#f"))
  994.   (haskell-send-to-process ")")
  995.   (setq *last-pad* pname)
  996.   (setq *last-module* mname)
  997.   (setq *last-loaded* fname))
  998.  
  999.  
  1000.  
  1001. ;;; HASKELL-RUN-FILE, HASKELL-LOAD, HASKELL-COMPILE
  1002. ;;; ------------------------------------------------------------------
  1003.  
  1004. (defun haskell-run-file ()
  1005.   "Runs Dialogue named main in current file."
  1006.   (interactive)
  1007.   (haskell-maybe-create-process)
  1008.   (let ((fname  (haskell-get-file-to-operate-on)))
  1009.     (haskell-save-modified-source-files fname)
  1010.     (haskell-send-to-process ":(emacs-run-file")
  1011.     (haskell-send-to-process (prin1-to-string fname))
  1012.     (haskell-send-to-process ")")))
  1013.  
  1014. (defun haskell-load ()
  1015.   "Load current file."
  1016.   (interactive)
  1017.   (haskell-maybe-create-process)
  1018.   (let ((fname  (haskell-get-file-to-operate-on)))
  1019.     (haskell-save-modified-source-files fname)
  1020.     (haskell-send-to-process ":(emacs-load-file")
  1021.     (haskell-send-to-process (prin1-to-string fname))
  1022.     (haskell-send-to-process ")")))
  1023.  
  1024. (defun haskell-compile ()
  1025.   "Compile current file."
  1026.   (interactive)
  1027.   (haskell-maybe-create-process)
  1028.   (let ((fname  (haskell-get-file-to-operate-on)))
  1029.     (haskell-save-modified-source-files fname)
  1030.     (haskell-send-to-process ":(emacs-compile-file")
  1031.     (haskell-send-to-process (prin1-to-string fname))
  1032.     (haskell-send-to-process ")")))
  1033.  
  1034.  
  1035. (defun haskell-get-file-to-operate-on ()
  1036.   (cond ((equal *haskell-buffer* (buffer-name))
  1037.      ;; When called from the haskell process buffer, prompt for a file.
  1038.      (call-interactively 'haskell-get-file/prompt))
  1039.     ((buffer-file-name)
  1040.      ;; When called from a .hs file buffer, use the unit file
  1041.      ;; associated with it, if there is one.
  1042.      (haskell-maybe-get-unit-file-name (buffer-file-name)))
  1043.     (t
  1044.      ;; When called from a pad, use the file that the module the
  1045.      ;; pad belongs to lives in.
  1046.      (haskell-maybe-get-unit-file-name 
  1047.        (haskell-get-file-from-pad (buffer-name (current-buffer)))))))
  1048.  
  1049. (defun haskell-get-file/prompt (filename)
  1050.   (interactive "fHaskell file:  ")
  1051.   (haskell-run-file-aux filename))
  1052.  
  1053.  
  1054.  
  1055. ;;; HASKELL-EXIT
  1056. ;;; ------------------------------------------------------------------
  1057.  
  1058. (defun haskell-exit ()
  1059.   "Quit the haskell process."
  1060.   (interactive)
  1061.   (cond ((not (haskell-process-exists-p))
  1062.      (message "No process currently running."))
  1063.     ((y-or-n-p "Do you really want to quit Haskell? ")
  1064.      (haskell-send-to-process ":quit")
  1065.      ;; If we were running the tutorial, mark the temp buffer as unmodified
  1066.      ;; so we don't get asked about saving it later.
  1067.      (if (and *ht-temp-buffer*
  1068.           (get-buffer *ht-temp-buffer*))
  1069.          (save-excursion
  1070.            (set-buffer *ht-temp-buffer*)
  1071.            (set-buffer-modified-p nil)))
  1072.      ;; Try to remove the haskell output buffer from the screen.
  1073.      (bury-buffer *haskell-buffer*)
  1074.      (replace-buffer-in-windows *haskell-buffer*))
  1075.     (t
  1076.      nil)))
  1077.  
  1078.  
  1079. ;;; HASKELL-INTERRUPT
  1080. ;;; ------------------------------------------------------------------
  1081.  
  1082. (defun haskell-interrupt ()
  1083.   "Interrupt the haskell process."
  1084.   (interactive)
  1085.   (if (haskell-process-exists-p)
  1086.       (haskell-send-to-process "\C-c")))
  1087.  
  1088.  
  1089.  
  1090. ;;; HASKELL-EDIT-UNIT
  1091. ;;; ------------------------------------------------------------------
  1092.  
  1093. (defun haskell-edit-unit ()
  1094.   "Edit the .hu file."
  1095.   (interactive)
  1096.   (let ((fname       (buffer-file-name)))
  1097.     (if fname
  1098.     (let ((find-file-not-found-hooks  (list 'haskell-new-unit))
  1099.           (file-not-found             nil)
  1100.           (units-fname                (haskell-get-unit-file-name fname)))
  1101.       (find-file-other-window units-fname)
  1102.       ;; If creating a new file, initialize it to contain the name
  1103.       ;; of the haskell source file.
  1104.       (if file-not-found
  1105.           (save-excursion
  1106.         (insert
  1107.               (if (string= (file-name-directory fname)
  1108.                    (file-name-directory units-fname))
  1109.               (file-name-nondirectory fname)
  1110.               fname)
  1111.           "\n"))))
  1112.     (haskell-mode-error "Not in a .hs buffer!"))))
  1113.  
  1114. (defun haskell-new-unit ()
  1115.   (setq file-not-found t))
  1116.  
  1117.  
  1118. ;;; Look for a comment like "-- unit:" at top of file.
  1119. ;;; If not found, assume unit file has same name as the buffer but
  1120. ;;; a .hu extension.
  1121.  
  1122. (defun haskell-get-unit-file-name (fname)
  1123.   (or (haskell-get-unit-file-name-from-file fname)
  1124.       (concat (haskell-strip-file-extension fname) ".hu")))
  1125.  
  1126. (defun haskell-maybe-get-unit-file-name (fname)
  1127.   (or (haskell-get-unit-file-name-from-file fname)
  1128.       (haskell-strip-file-extension fname)))
  1129.  
  1130. (defun haskell-get-unit-file-name-from-file (fname)
  1131.   (let ((buffer  (get-file-buffer fname)))
  1132.     (if buffer
  1133.     (save-excursion
  1134.       (beginning-of-buffer)
  1135.       (if (re-search-forward "-- unit:[ \t]*" (point-max) t)
  1136.           (let ((beg  (match-end 0)))
  1137.         (end-of-line)
  1138.         (buffer-substring beg (point)))
  1139.           nil))
  1140.     nil)))
  1141.  
  1142.  
  1143.  
  1144.  
  1145. ;;; ==================================================================
  1146. ;;; Support for printers/optimizers menus
  1147. ;;; ==================================================================
  1148.  
  1149. ;;; This code was adapted from the standard buff-menu.el code.
  1150.  
  1151. (defvar haskell-menu-mode-map nil "")
  1152.  
  1153. (if (not haskell-menu-mode-map)
  1154.     (progn
  1155.       (setq haskell-menu-mode-map (make-keymap))
  1156.       (suppress-keymap haskell-menu-mode-map t)
  1157.       (define-key haskell-menu-mode-map "m" 'hm-mark)
  1158.       (define-key haskell-menu-mode-map "u" 'hm-unmark)
  1159.       (define-key haskell-menu-mode-map "x" 'hm-exit)
  1160.       (define-key haskell-menu-mode-map "q" 'hm-exit)
  1161.       (define-key haskell-menu-mode-map " " 'next-line)
  1162.       (define-key haskell-menu-mode-map "\177" 'hm-backup-unmark)
  1163.       (define-key haskell-menu-mode-map "?" 'describe-mode)))
  1164.  
  1165. ;; Printers Menu mode is suitable only for specially formatted data.
  1166.  
  1167. (put 'haskell-menu-mode 'mode-class 'special)
  1168.  
  1169. (defun haskell-menu-mode ()
  1170.   "Major mode for editing Haskell flags.
  1171. Each line describes a flag.
  1172. Letters do not insert themselves; instead, they are commands.
  1173. m -- mark flag (turn it on)
  1174. u -- unmark flag (turn it off)
  1175. x -- exit; tell the Haskell process to update the flags, then leave menu.
  1176. q -- exit; same as x.
  1177. Precisely,\\{haskell-menu-mode-map}"
  1178.   (kill-all-local-variables)
  1179.   (use-local-map haskell-menu-mode-map)
  1180.   (setq truncate-lines t)
  1181.   (setq buffer-read-only t)
  1182.   (setq major-mode 'haskell-menu-mode)
  1183.   (setq mode-name "Haskell Flags Menu")
  1184.   ;; These are all initialized elsewhere
  1185.   (make-local-variable 'hm-current-flags)
  1186.   (make-local-variable 'hm-request-fn)
  1187.   (make-local-variable 'hm-update-fn)
  1188.   (run-hooks 'haskell-menu-mode-hook))
  1189.  
  1190.  
  1191. (defun haskell-menu (help-file buffer request-fn update-fn)
  1192.   (haskell-maybe-create-process)
  1193.   (if (get-buffer buffer)
  1194.       (progn
  1195.     (pop-to-buffer buffer)
  1196.     (goto-char (point-min)))
  1197.       (progn
  1198.         (pop-to-buffer buffer)
  1199.     (insert-file-contents help-file)
  1200.     (haskell-menu-mode)
  1201.     (setq hm-request-fn request-fn)
  1202.     (setq hm-update-fn update-fn)
  1203.     ))
  1204.   (hm-mark-current)
  1205.   (message "m = mark; u = unmark; x = execute; q = quit; ? = more help."))
  1206.  
  1207.  
  1208.  
  1209. ;;; A line that starts with *hm-marked* is a menu item turned on.
  1210. ;;; A line that starts with *hm-unmarked* is turned off.
  1211. ;;; A line that starts with anything else is just random text and is
  1212. ;;; ignored by commands that deal with menu items.
  1213.  
  1214. (defvar *hm-marked*   " on")
  1215. (defvar *hm-unmarked* "   ")
  1216. (defvar *hm-marked-regexp*   " on   \\w")
  1217. (defvar *hm-unmarked-regexp* "      \\w")
  1218.  
  1219. (defun hm-mark ()
  1220.   "Mark flag to be turned on."
  1221.   (interactive)
  1222.   (beginning-of-line)
  1223.   (cond ((looking-at *hm-marked-regexp*)
  1224.      (forward-line 1))
  1225.     ((looking-at *hm-unmarked-regexp*)
  1226.      (let ((buffer-read-only  nil))
  1227.        (delete-char (length *hm-unmarked*))
  1228.        (insert *hm-marked*)
  1229.        (forward-line 1)))
  1230.     (t
  1231.      (forward-line 1))))
  1232.  
  1233. (defun hm-unmark ()
  1234.   "Unmark flag."
  1235.   (interactive)
  1236.   (beginning-of-line)
  1237.   (cond ((looking-at *hm-unmarked-regexp*)
  1238.      (forward-line 1))
  1239.     ((looking-at *hm-marked-regexp*)
  1240.      (let ((buffer-read-only  nil))
  1241.        (delete-char (length *hm-marked*))
  1242.        (insert *hm-unmarked*)
  1243.        (forward-line 1)))
  1244.     (t
  1245.      (forward-line 1))))
  1246.  
  1247. (defun hm-backup-unmark ()
  1248.   "Move up and unmark."
  1249.   (interactive)
  1250.   (forward-line -1)
  1251.   (hm-unmark)
  1252.   (forward-line -1))
  1253.  
  1254.  
  1255. ;;; Actually make the changes.
  1256.  
  1257. (defun hm-exit ()
  1258.   "Update flags, then leave menu."
  1259.   (interactive)
  1260.   (hm-execute)
  1261.   (hm-quit))
  1262.  
  1263. (defun hm-execute ()
  1264.   "Tell haskell process to tweak flags."
  1265.   (interactive)
  1266.   (save-excursion
  1267.     (goto-char (point-min))
  1268.     (let ((flags-on   nil)
  1269.       (flags-off  nil))
  1270.       (while (not (eq (point) (point-max)))
  1271.     (cond ((looking-at *hm-unmarked-regexp*)
  1272.            (setq flags-off (cons (hm-flag) flags-off)))
  1273.           ((looking-at *hm-marked-regexp*)
  1274.            (setq flags-on (cons (hm-flag) flags-on)))
  1275.           (t
  1276.            nil))
  1277.     (forward-line 1))
  1278.       (funcall hm-update-fn flags-on flags-off))))
  1279.  
  1280.  
  1281. (defun hm-quit ()
  1282.   (interactive)
  1283.   "Make the menu go away."
  1284.   (bury-buffer (current-buffer))
  1285.   (replace-buffer-in-windows (current-buffer)))
  1286.  
  1287. (defun hm-flag ()
  1288.   (save-excursion
  1289.     (beginning-of-line)
  1290.   the haskell tutorial."
  1291.   (interactive)
  1292.   (ht-load-tutorial)
  1293.   (ht-make-buffer)
  1294.   (ht-display-page)
  1295.   (haskell-maybe-create-process)
  1296.   (haskell-send-to-process ":(emacs-set-printers '(interactive))")
  1297.   )
  1298.  
  1299.  
  1300. ;;; Load the tutorial file into a read-only buffer.  Do not display this
  1301. ;;; buffer.
  1302.  
  1303. (defun ht-load-tutorial ()
  1304.   (let ((buffer  (get-buffer *ht-file-buffer*)))
  1305.     (if buffer
  1306.     (save-excursion
  1307.       (set-buffer buffer)
  1308.       (beginning-of-buffer))
  1309.     (save-excursion
  1310.       (set-buffer (setq buffer (get-buffer-create *ht-file-buffer*)))
  1311.       (let ((fname (substitute-in-file-name *ht-source-file*)))
  1312.         (if (file-readable-p fname)
  1313.         (ht-load-tutorial-aux fname)
  1314.         (call-interactively 'ht-load-tutorial-aux)))))))
  1315.  
  1316. (defun ht-load-tutorial-aux (filename)
  1317.   (interactive "fTutorial file: ")
  1318.   (insert-file filename)
  1319.   (set-buffer-modified-p nil)
  1320.   (setq buffer-read-only t)
  1321.   (beginning-of-buffer))
  1322.  
  1323.  
  1324. ;;; Create a buffer to use for messing about with each page of the tutorial.
  1325. ;;; Put the buffer into haskell-tutorial-mode.
  1326.  
  1327. (defun ht-make-buffer ()
  1328.   (find-file (concat "/tmp/" (make-temp-name "ht") ".lhs"))
  1329.   (setq *ht-temp-buffer* (buffer-name))
  1330.   (haskell-tutorial-mode))
  1331.  
  1332.  
  1333. ;;; Commands for loading text into the tutorial pad buffer
  1334.  
  1335. (defun ht-next-page ()
  1336.   "Go to the next tutorial page."
  1337.   (interactive)
  1338.   (if (ht-goto-next-page)
  1339.       (ht-display-page)
  1340.       (beep)))
  1341.  
  1342. (defun ht-goto-next-page ()
  1343.   (let ((buff  (current-buffer)))
  1344.     (unwind-protect
  1345.     (progn
  1346.       (set-buffer *ht-file-buffer*)
  1347.       (search-forward "\C-l" nil t))
  1348.       (set-buffer buff))))
  1349.  
  1350. (defun ht-prev-page ()
  1351.   "Go to the previous tutorial page."
  1352.   (interactive)
  1353.   (if (ht-goto-prev-page)
  1354.       (ht-display-page)
  1355.       (beep)))
  1356.  
  1357. (defun ht-goto-prev-page ()
  1358.   (let ((buff  (current-buffer)))
  1359.     (unwind-protect
  1360.     (progn
  1361.       (set-buffer *ht-file-buffer*)
  1362.       (search-backward "\C-l" nil t))
  1363.       (set-buffer buff))))
  1364.  
  1365. (defun ht-goto-page (arg)
  1366.   "Go to the tutorial page specified as the argument."
  1367.   (interactive "sGo to page: ")
  1368.   (if (ht-searchfor-page (format "Page: %s " arg))
  1369.       (ht-display-page)
  1370.       (beep)))
  1371.  
  1372. (defun ht-goto-section (arg)
  1373.   "Go to the tutorial section specified as the argument."
  1374.   (interactive "sGo to section: ")
  1375.   (if (ht-searchfor-page (format "Section: %s " arg))
  1376.       (ht-display-page)
  1377.       (beep)))
  1378.  
  1379. (defun ht-searchfor-page (search-string)
  1380.   (let ((buff           (current-buffer)))
  1381.     (unwind-protect
  1382.     (progn
  1383.       (set-buffer *ht-file-buffer*)
  1384.       (let ((point  (point)))
  1385.         (beginning-of-buffer)
  1386.         (if (search-forward search-string nil t)
  1387.         t
  1388.         (progn
  1389.           (goto-char point)
  1390.           nil))))
  1391.       (set-buffer buff))))
  1392.  
  1393. (defun ht-restore-page ()
  1394.   (interactive)
  1395.   (let ((old-point  (point)))
  1396.     (ht-display-page)
  1397.     (goto-char old-point)))
  1398.  
  1399. (defun ht-display-page ()
  1400.   (set-buffer *ht-file-buffer*)
  1401.   (let* ((beg   (progn
  1402.          (if (search-backward "\C-l" nil t)
  1403.              (forward-line 1)
  1404.              (beginning-of-buffer))
  1405.          (point)))
  1406.      (end   (progn
  1407.           (if (search-forward "\C-l" nil t)
  1408.               (beginning-of-line)
  1409.               (end-of-buffer))
  1410.           (point)))
  1411.      (text  (buffer-substring beg end)))
  1412.     (set-buffer *ht-temp-buffer*)
  1413.     (erase-buffer)
  1414.     (insert text)
  1415.     (beginning-of-buffer)))
  1416.  
  1417.  
  1418.  
  1419. ;;;======================================================================
  1420. ;;; Menu bar stuff
  1421. ;;;======================================================================
  1422.  
  1423. ;;; This only works in Emacs version 19, so it's in a separate file for now.
  1424.  
  1425. (if (featurep 'menu-bar)
  1426.     (load-library "haskell-menu"))
  1427.